home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The CICA Windows Explosion!
/
The CICA Windows Explosion! - Disc 2.iso
/
programr
/
wtj201.zip
/
DUMPLDT.ZIP
/
DUMPLDT.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1992-11-06
|
9KB
|
334 lines
{$S-,R-,V-,I-,B-,F-,W-,A-,G-,X+,N-}
{****************************************************}
{* DUMPLDT.PAS 1.00 *}
{* by Richard S. Sadowsky }
{****************************************************}
program DumpLDT;
{-Dumps the Local Descriptor Table.}
uses
WinTypes, WinProcs, WinDos, Strings,
{$IFDEF VER70}
Objects, OWindows, ODialogs,
{$ELSE}
WObjects, StdDlgs,
{$ENDIF}
ToolHelp;
type
DescriptorTableEntry =
record
LimitL : Word;
BaseL : Word;
Words : Array[0..1] of Word;
end;
Long =
record
LowWord, HighWord : Word;
end;
PLDTList = ^TLDTList;
TLDTList = {an LDT "list box"}
object(TListBox)
procedure BuildList;
end;
DumpLDTApplication =
object(TApplication)
procedure InitMainWindow; virtual;
end;
PLDTWindow = ^LDTWindow;
LDTWindow =
object(TWindow)
LDTLB : PLDTList;
constructor Init(AParent : PWindowsObject; ATitle : PChar);
procedure SetupWindow; virtual;
procedure WMActivateApp(var Msg : TMessage);
virtual wm_First + wm_ActivateApp;
procedure wmSetFocus(var Msg : TMessage);
virtual wm_First+wm_SetFocus;
procedure wmSize(var Msg : TMessage);
virtual wm_First+wm_Size;
end;
var
LDTApp : DumpLDTApplication;
const
Digits : array[0..$F] of Char = '0123456789ABCDEF'; {for hex routines}
function GetDescriptor(Selector : Word; var Descriptor : DescriptorTableEntry) : Word; Assembler;
{-DPMI Get Descriptor function. Returns 0 on success.}
asm
mov ax,000Bh
mov bx,Selector
les di,Descriptor
int 31h
jc @@ExitPoint
xor ax,ax
@@ExitPoint:
end;
function Long2Str(Dest : PChar; L : LongInt) : PChar;
{-Convert a long/word/integer/byte/shortint to a string}
var
S : string;
begin
Str(L, S);
Long2Str := StrPCopy(Dest, S);
end;
function HexB(Dest : PChar; B : Byte) : PChar;
{-Return hex string for byte}
begin
HexB := Dest;
Dest^ := Digits[B shr 4];
Inc(Dest);
Dest^ := Digits[B and $F];
Inc(Dest);
Dest^ := #0;
end;
function HexW(Dest : PChar; W : Word) : PChar;
{-Return hex string for word}
begin
HexW := Dest;
Dest^ := Digits[hi(W) shr 4];
Inc(Dest);
Dest^ := Digits[hi(W) and $F];
Inc(Dest);
Dest^ := Digits[lo(W) shr 4];
Inc(Dest);
Dest^ := Digits[lo(W) and $F];
Inc(Dest);
Dest^ := #0;
end;
function HexL(Dest : PChar; L : LongInt) : PChar;
{-Return hex string for LongInt}
var
T2 : Array[0..4] of Char;
begin
with Long(L) do
HexL := StrCat(HexW(Dest, HighWord), HexW(T2, LowWord));
end;
function LeftPad(S : PChar; Len : Word) : PChar; Assembler;
{-Return a string left-padded to length len with spaces}
asm
les di,S
mov dx,es
mov bx,di
cld
xor al,al
mov cx,0FFFFh
repne scasb
not cx
dec cx
mov ax,Len
sub ax,cx
jbe @@ExitPoint
push ds
mov ds,dx
mov si,bx
mov di,bx
std
add si,cx
add di,Len
inc cx
rep movsb
mov cx,ax
mov al,' '
rep stosb
pop ds
@@ExitPoint:
cld
mov ax,bx
end;
constructor LDTWindow.Init(AParent : PWindowsObject; ATitle : PChar);
{-Initialize our main window}
begin
TWindow.Init(AParent, ATitle);
with Attr do begin
W := 450;
H := 335;
end;
LDTLB := New(PLDTList, Init(@Self, 201, 0, 0, 0, 0));
end;
procedure ParseDesc(var Desc : DescriptorTableEntry; var Base : LongInt; var Limit : LongInt; var TypeOfField : Byte; var DPL : Byte);
{-Break a descriptor up into its components.}
begin
with Desc do begin
Limit := LongInt(LimitL) or (LongInt(Words[1] and $0F) shl 16);
Base := LongInt(BaseL) or (LongInt((Words[0] and $00FF) or (Words[1] and $FF00)) shl 16);
TypeOfField := (Words[0] shr 8) and $0F;
DPL := (Words[0] shr 13) and $03;
end;
end;
function ValidDesc(var Desc : DescriptorTableEntry) : Boolean;
{-Return True if the descriptor seems valid.}
var
Base, Limit : LongInt;
Typ, DPL : Byte;
begin
ParseDesc(Desc, Base, Limit, Typ, DPL);
ValidDesc := (Typ <> 0) and (Typ <> $F);
end;
function Desc2Str(Selector : Word; var Desc : DescriptorTableEntry; P : PChar) : Boolean;
{-Create the line to display in the LDT list box for a selector.}
var
Base, Limit : LongInt;
Typ, DPL : Byte;
N : Array[0..10] of Char;
type
CodeDataStr = Array[0..5] of Char;
ReadWriteStr = Array[0..4] of Char;
UpDownStr = Array[0..2] of Char;
AccessedStr = Array[0..2] of Char;
LoadedStr = Array[0..3] of Char;
const
CodeData : Array[Boolean] of CodeDataStr = (' data', ' code');
ReadWrite : Array[Boolean] of ReadWriteStr = (' R ', ' R/W');
Accessed : Array[Boolean] of AccessedStr = (' N', ' A');
UpDown : Array[Boolean] of UpDownStr = (' U', ' D');
Loaded : Array[Boolean] of LoadedStr = (' U ', ' L ');
begin
ParseDesc(Desc, Base, Limit, Typ, DPL);
if (Typ = 0) or (Typ = $F) then begin
Desc2Str := False;
Exit;
end
else
Desc2Str := True;
HexW(P, Selector);
Long2Str(N, Limit + 1);
StrCat(P, LeftPad(N, 8));
StrCat(P, ' ');
StrCat(P, HexB(N, DPL));
if Typ and $08 > 0 then begin
StrCat(P, CodeData[True]);
StrCat(P, ReadWrite[False]);
StrCat(P, ' ');
end
else begin
StrCat(P, CodeData[False]);
StrCat(P, ReadWrite[Typ and $02 > 0]);
StrCat(P, UpDown[Typ and $04 > 0]);
end;
StrCat(P, Accessed[Typ and $01 > 0]);
StrCat(P, Loaded[Desc.Words[0] and $8000 > 0]);
StrCat(P, HexL(N, Base));
StrCat(P, ' ');
end;
function WinHeapInfo(Sel : Word; S : Pchar) : PChar;
{-Attempt to get Windows heap info. If successful, build string.}
type
GTNameStr = Array[0..9] of Char;
const
gtNames : Array[0..10] of gtNameStr = ('Unknown ', 'DGroup ', 'Data ', 'Code ', 'Task ', 'Resource ', 'Module ', 'Free ', 'Internal ', 'Sentinel ', 'Burger M ');
var
Global : ToolHelp.TGlobalEntry;
Task : TTaskEntry;
Module : TModuleEntry;
begin
WinHeapInfo := S;
FillChar(Global, SizeOf(Global), 0);
Global.dwSize := SizeOf(Global);
if ToolHelp.GlobalEntryHandle(@Global, Sel) then begin
if Global.wType in [0..10] then
StrCopy(S, gtNames[Global.wType])
else
StrCopy(S, 'Invalid ');
FillChar(Task, SizeOf(Task), 0);
Task.dwSize := SizeOf(Task);
if TaskFindHandle(@Task, Global.hOwner) then
StrCat(S, Task.szModule)
else begin
FillChar(Module, SizeOf(Module), 0);
Module.dwSize := SizeOf(Module);
if ModuleFindHandle(@Module, Global.hOwner) <> 0 then
StrCat(S, Module.szModule);
end;
end
else
S[0] := #0;
end;
function GetItemStr(Dest : PChar; var Desc : DescriptorTableEntry; Sel : Word) : PChar;
{-Return a string for display in the listbox for the given selector}
var
WS : Array[0..40] of Char;
begin
if Desc2Str(Sel, Desc, Dest) then
StrCat(Dest, WinHeapInfo(Sel, WS))
else
Dest^ := #0;
GetItemStr := Dest;
end;
procedure TLDTList.BuildList;
{-Loop through all selectors finding valid ones to put in listbox.}
var
NewCursor, OldCursor : HCursor;
Index, Sel : Word;
Desc : DescriptorTableEntry;
I : Integer;
DescStr : Array[0..255] of Char;
begin
NewCursor := LoadCursor(0, idc_Wait);
OldCursor := SetCursor(NewCursor);
ClearList;
for Index := 0 to $1FFF do begin
Sel := (Index * 8) or 7; {calc value for valid LDT selector}
if GetDescriptor(Sel, Desc) = 0 then
if ValidDesc(Desc) then
if AddString(GetItemStr(DescStr, Desc, Sel)) = -1 then ;
{ignores errors}
end;
SetCursor(OldCursor);
end;
procedure LDTWindow.SetupWindow;
{-Set the ansi fixed font}
begin
TWindow.SetupWindow;
SendMessage(LDTLB^.HWindow, wm_SetFont, GetStockObject(Ansi_Fixed_Font), 0);
end;
procedure LDTWindow.WMActivateApp(var Msg : TMessage);
{-Rebuild list each time focus is received by application}
begin
if Msg.wParam > 0 then
LDTLB^.BuildList;
end;
procedure LDTWindow.wmSetFocus(var Msg : TMessage);
begin
{give the focus to the list box}
SetFocus(LDTLB^.hWindow);
end;
procedure LDTWindow.wmSize(var Msg : TMessage);
{-Handle resizing}
begin
TWindow.wmSize(Msg);
{resize list box to fill client area of parent}
SetWindowPos(LDTLB^.hWindow, 0, 0, 0, Msg.lParamLo, Msg.lParamHi, swp_NoZOrder);
end;
procedure DumpLDTApplication.InitMainWindow;
{-Init our list box window}
begin
MainWindow := New(PLDTWindow, Init(nil, 'Dump LDT'));
end;
begin {main}
LDTApp.Init('Dump LDT');
LDTApp.Run;
LDTApp.Done;
end.